home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-01-31 | 10.7 KB | 416 lines | [TEXT/MPS ] |
- unit UAboutWindow;
- {$S Main}
-
- interface
-
- uses
- Quickdraw, ToolIntf, OSUtils,
- UGlobals;
-
- const
- AboutRefCon = 1234;
-
- var
- AboutWindow: WindowPtr;
-
- procedure InitAboutWindow; (* Call during ROM initializations *)
- procedure OpenAboutWindow; (* Call when the user selects "About..." *)
- function CloseIfAboutWindow (whichWindow: WindowPtr): Boolean; (* Call if the user wants to close a window. *)
- (* Returns TRUE if the window was closed *)
-
- function AboutEventProc (theEvent: EventRecord): Boolean; (* Call each time through your main event loop. *)
- (* Returns TRUE if the result was handled for you *)
-
- implementation
-
- const
- kAboutWindowID = 2000;
- vScrollRef = 1;
- findButtonRef = 2;
- LineSize = 9; (* The font size of the about window *)
- LineSpacing = 13; (* The distance between baselines in the about window *)
-
- var
- AboutTEHandle: TEHandle;
- HasStyledTE: Boolean;
-
- (* Private routines *)
- procedure CalcTextRect (wPtr: WindowPtr; var outlineRect, textRect: Rect);
- begin
- with wPtr^.portRect do
- SetRect(outlineRect, left + 8, top + 8, right - 24, bottom - 8);
- textRect := outlineRect;
- InsetRect(outlineRect, -2, -2);
- with textRect do
- bottom := bottom - ((bottom - top) mod LineSpacing);
- end; (* CalcTextRect *)
-
- procedure UpdateAboutWindow (wPtr: WindowPtr);
- var
- oldPort: GrafPtr;
- outlineRect, textRect: Rect;
-
- begin
- GetPort(oldPort);
- SetPort(wPtr);
- BeginUpdate(wPtr);
- EraseRect(wPtr^.portRect);
- if wPtr = AboutWindow then
- begin
- CalcTextRect(wPtr, outlineRect, textRect);
- TEUpdate(wPtr^.visRgn^^.rgnBBox, AboutTEHandle);
- FrameRect(outlineRect);
- end;
- DrawControls(wPtr);
- EndUpdate(wPtr);
- SetPort(oldPort);
- end; (* UpdateAboutWindow *)
-
-
- procedure ActivateAboutWindow (myEvent: EventRecord);
- var
- wPtr: WindowPtr;
-
- begin
- wPtr := WindowPtr(myEvent.message);
- (* DrawGrowIcon(wPtr); *)
- if wPtr = AboutWindow then
- begin
- if ODD(myEvent.modifiers) then
- TEActivate(AboutTEHandle)
- else
- TEDeactivate(AboutTEHandle);
- end;
- if ODD(myEvent.modifiers) then
- SetPort(wPtr);
- end; (* ActivateAboutWindow *)
-
- procedure ScrollDisplay (whichWindow: WindowPtr; vScroll: ControlHandle);
- var
- oldValue, newValue, delta: INTEGER;
-
- begin
- newValue := GetCtlValue(vScroll) * LineSpacing;
- with AboutTEHandle^^ do
- oldValue := viewRect.top - destRect.top;
- delta := oldValue - newValue;
- TEScroll(0, delta, AboutTEHandle);
- end; (* ScrollDisplay *)
-
-
- procedure ScrollActionProc (whichControl: ControlHandle; partCode: INTEGER);
- const
- delay = 0;
-
- var
- ok: Boolean;
- min, max, value, delta: INTEGER;
- oldTime: LONGINT;
- outlineRect, textRect: Rect;
- visLines: INTEGER;
-
- begin
- CalcTextRect(FrontWindow, outlineRect, textRect);
- with textRect do
- visLines := (bottom - top) div LineSpacing;
-
- max := GetCtlMax(whichControl);
- min := GetCtlMin(whichControl);
- ok := TRUE;
- oldTime := TickCount;
- case partCode of
- inUpButton:
- delta := -1;
- inDownButton:
- delta := 1;
- inPageUp:
- delta := -visLines;
- inPageDown:
- delta := visLines;
- otherwise
- ok := FALSE;
- end;
- if ok then
- begin
- value := GetCtlValue(whichControl);
- if not ((value = min) and (delta < 0)) or ((value = max) and (delta > 0)) then
- SetCtlValue(whichControl, value + delta);
-
- ScrollDisplay(FrontWindow, whichControl);
- end;
-
- (* Set an upper limit on the speed of the control tracking *)
- while (TickCount < (oldTime + delay)) do
- ;
- end; (* ScrollActionProc *)
-
-
- procedure DoMouseInAbout (myEvent: EventRecord);
- var
- globalPt, localPt: Point;
- outlineRect, textRect: Rect;
- partCode: INTEGER;
- whichControl: ControlHandle;
-
- begin
- globalPt := myEvent.where;
- if AboutWindow <> FrontWindow then
- SelectWindow(AboutWindow)
- else
- begin
- SetPort(AboutWindow);
- localPt := GlobalPt;
- GlobalToLocal(localPt);
- CalcTextRect(AboutWindow, outlineRect, textRect);
- if PtInRect(localPt, textRect) then
- (* TEClick(localPt, BitAnd(myEvent.modifiers, shiftKey) <> 0, AboutTEHAndle) *)
- else
- begin
- partCode := FindControl(localPt, AboutWindow, whichControl);
- case partCode of
- 0:
- ; (* do nothing *)
- inUpButton, inDownButton, inPageUp, inPageDown:
- partCode := TrackControl(whichControl, localPt, @ScrollActionProc);
-
- inThumb:
- begin
- partCode := TrackControl(whichControl, localPt, nil);
- if (partCode <> 0) then
- ScrollDisplay(AboutWindow, whichControl);
- end;
-
- end; (* CASE *)
- end; (* Check the controls *)
- end; (* We're the frontmost window *)
- end; (* DoMouseInAbout *)
-
- (* Public routines *)
-
- procedure InitAboutWindow;
- const
- TEStylNewTrapNumber = $A83E; { trap number of TEStylNew }
- UnimplementedTrapNumber = $A89F; {number of "unimplemented trap"}
-
- var
- rom: integer; (* Which version of the ROM are we running? *)
- machine: integer; (* Which machine is this?? *)
-
- begin
- AboutWindow := nil;
- AboutTEHandle := nil;
- Environs(rom, machine); (* Make sure that we can call SysEnvirons -- the LSP glue doesn't *)
- if (rom >= 117) then (* This is a Mac 512Ke or later , so we can see if we have WaitNextEvent *)
- HasStyledTE := NGetTrapAddress(TEStylNewTrapNumber, ToolTrap) <> GetTrapAddress(UnimplementedTrapNumber)
- else
- HasStyledTE := FALSE;
- end; (* InitAboutWindow *)
-
- procedure AdjustAboutWindow;
- var
- newViewRect, bodyFrameRect: Rect;
- vScroll: ControlHandle;
- numLines: INTEGER;
- newMaxValue: INTEGER;
-
- begin
- SetCursor(GetCursor(watchCursor)^^);
- CalcTextRect(AboutWindow, bodyFrameRect, newViewRect);
- SetPort(AboutWindow);
- InvalRect(newViewRect);
- vScroll := WindowPeek(AboutWindow)^.ControlList;
-
- EraseRect(AboutWindow^.portRect);
- with bodyFrameRect do
- begin
- HideControl(vScroll);
- MoveControl(vScroll, right - 1, top);
- SizeControl(vScroll, 16, (bottom - top));
- ShowControl(vScroll);
- ValidRect(vScroll^^.contrlRect);
- end;
- FrameRect(bodyFrameRect);
-
- with AboutTEHandle^^ do
- begin
- destRect := newViewRect;
- viewRect := newViewRect;
- end;
- TECalText(AboutTEHandle);
- with AboutTEHandle^^ do
- begin
- numLines := nLines;
- if (CharsHandle(hText)^^[teLength] = CHR(13)) then
- numLines := nLines + 1;
- end;
-
- with newViewRect do
- begin
- newMaxValue := ((numLines * LineSpacing) - (bottom - top)) div LineSpacing;
- if newMaxValue < 0 then
- newMaxValue := 0;
- SetCtlMax(vScroll, newMaxValue);
- end;
- InitCursor;
- end; (* AdjustAboutWindow *)
-
-
- procedure OpenAboutWindow;
-
- procedure GetAboutWindowText;
- var
- scratchRect: Rect;
- tHandle: Handle;
- scratchControl: ControlHandle;
-
- begin
- SetRect(scratchRect, 0, 0, 10, 10);
- TextFont(geneva);
- TextFace([]);
- TextSize(LineSize);
- if HasStyledTE then
- AboutTEHandle := TEStylNew(scratchRect, scratchRect)
- else
- AboutTEHandle := TENew(scratchRect, scratchRect);
- tHandle := GetNamedResource('TEXT', 'About');
- if (THandle <> nil) then
- begin
- HLock(THandle);
- if HasStyledTE then
- TEStylInsert(THandle^, GetHandleSize(THandle), stScrpHandle(GetNamedResource('styl', 'About')), AboutTEHandle)
- else
- TESetText(THandle^, GetHandleSize(THandle), AboutTEHandle);
- TESetSelect(0, 0, AboutTEHandle);
- ReleaseResource(THandle);
- (* Add the controls *)
- SetWRefCon(AboutWindow, AboutRefCon);
- scratchControl := NewControl(AboutWindow, scratchRect, '', TRUE, 0, 0, 0, 16, vScrollRef);
-
- AdjustAboutWindow;
- ShowWindow(AboutWindow);
- end
- else
- begin
- DisposeWindow(AboutWindow);
- TEDispose(AboutTEHandle);
- AboutWindow := nil;
- end;
- end; (* GetAboutWindowText *)
-
- begin
- if (AboutWindow <> nil) then
- SelectWindow(AboutWindow)
- else
- begin
- AboutWindow := GetNewWindow(kAboutWindowID, nil, WindowPtr(-1));
- if (AboutWindow <> nil) then
- begin
- SetPort(AboutWindow);
- GetAboutWindowText;
- end;
- end;
- end; (* OpenAboutWindow *)
-
- function CloseIfAboutWindow (whichWindow: WindowPtr): Boolean;
- begin
- if (whichWindow = AboutWindow) and (AboutWindow <> nil) then
- begin
- HideWindow(AboutWindow);
- TEDispose(AboutTEHandle);
- AboutTEHandle := nil;
- DisposeControl(WindowPeek(AboutWindow)^.ControlList);
- DisposeWindow(AboutWindow);
- AboutWindow := nil;
- CloseIfAboutWindow := TRUE;
- end
- else
- CloseIfAboutWindow := FALSE;
- end; (* CloseAboutWindow *)
-
-
- function AboutEventProc (theEvent: EventRecord): Boolean;
- (* This returns TRUE if it handled the event, FALSE otherwise *)
- (* (It handles Null events (returning FALSE so you can take some time), Update, Activate, *)
- (* MouseDowns in Content, Grow, Zoom, and GoAway -- returning TRUE. You have to handle *)
- (* everything else (i.e. write a standard main event loop) *)
-
- var
- result: Boolean;
- location: INTEGER;
- whichWindow: WindowPtr;
- sizeLimits: Rect;
- newSize: LONGINT;
-
- begin
- result := FALSE;
- if (AboutWindow <> nil) then
- case theEvent.what of
- nullEvent:
- if (FrontWindow = AboutWindow) then
- TEIdle(AboutTEHandle);
- (* result := FALSE *)
-
- mouseDown:
- begin
- location := FindWindow(theEvent.where, whichWindow);
- if (whichWindow = AboutWindow) then
- case location of
- inContent:
- begin
- DoMouseInAbout(theEvent);
- result := TRUE;
- end;
-
- inGoAway:
- if TrackGoAway(AboutWindow, theEvent.where) then
- begin
- result := CloseIfAboutWindow(whichWindow);
- end;
-
- inGrow:
- begin
- sizeLimits := ScreenBits.bounds;
- InsetRect(sizeLimits, 32, 32);
- newSize := GrowWindow(AboutWindow, theEvent.where, sizeLimits);
- if (newSize <> 0) then
- begin
- SizeWindow(AboutWindow, LoWord(newSize), HiWord(newSize), FALSE);
- InvalRect(AboutWindow^.portRect);
- AdjustAboutWindow;
- UpdateAboutWindow(AboutWindow);
- result := TRUE;
- end;
- end;
-
- inZoomIn, inZoomOut:
- if TrackBox(AboutWindow, theEvent.where, location) then
- begin
- ZoomWindow(AboutWindow, location, FALSE);
- InvalRect(AboutWindow^.portRect);
- AdjustAboutWindow;
- UpdateAboutWindow(AboutWindow);
- result := TRUE;
- end;
-
- end; (* IF ... / CASE location OF *)
- end; (* CASE mouseDown *)
-
- UpdateEvt:
- if (WindowPtr(theEvent.message) = AboutWindow) then
- begin
- UpdateAboutWindow(AboutWindow);
- result := TRUE;
- end; (* IF *)
-
- ActivateEvt:
- if (WindowPtr(theEvent.message) = AboutWindow) then
- begin
- ActivateAboutWindow(theEvent);
- result := TRUE;
- end; (* IF *)
-
- end; (* CASE *)
- AboutEventProc := result;
- end; (* AboutEventProc *)
-
- end.